home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGASIC / STRBASIC.LZH / DEBUG.INC < prev    next >
Text File  |  1984-06-25  |  8KB  |  336 lines
  1. ' DEBUG.INC:    Structured BASIC Program Debugger, version 1.12
  2. '
  3. ' version:        6-20-84
  4. ' compiler:        Structured BASIC v1.12
  5. ' uses:            nothing
  6. ' module type:    include
  7.  
  8. procedure DEBUG.SETUP
  9.     'Set up stack of procedure names
  10.     DB.NPROCS = 10
  11.     dim DB.LABEL$(DB.NPROCS),DB.LINE(DB.NPROCS)
  12.  
  13.     'Set up cursor and output variables
  14.     DB.STATUS.LINE = 25
  15.     DB.CUROFF = 0 : DB.CURON = 1
  16.     DB.BLINK = 5 : DB.CURCNT = DB.BLINK
  17.     DB.CURSOR$ = chr$(&H5F)
  18.     DB.BKSP$ = chr$(8)
  19.     DB.RET$ = chr$(13)
  20.     DB.TLBOX$ = chr$(&HC9) : DB.TRBOX$ = chr$(&HBB)
  21.     DB.BLBOX$ = chr$(&HC8) : DB.BRBOX$ = chr$(&HBC)
  22.     DB.TOP$ = chr$(&HCD)   : DB.SIDE$ = chr$(&HBA)
  23.     DB.MASK$ = "\                              \"
  24.  
  25.     'String for proofing labels input as breakpoints
  26.     DB.LABCHRS$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789."
  27.  
  28.     'Establish error and key trapping (F10 stops debugger)
  29.     on error goto DB.BASIC.ERROR
  30.     on key(10) do DEBUG.KEYBD.STOP
  31.     key off
  32.     key (10) on
  33.  
  34.     DB.LEVEL = 0                'No procedures entered yet
  35.     DB.BPOINT = 0                'No breakpoints in effect
  36.     DB.CMDSTOP = 0                'No command keyboard stops
  37.  
  38.     do DEBUG.HELLO
  39.     do DEBUG.PUSH.CURSOR
  40.     do DEBUG.CLR.MSG
  41.     do DEBUG.CMD
  42. endproc
  43.  
  44. DB.BASIC.ERROR|                 'Error routine for BASIC errors
  45.     do DEBUG.BASIC.ERROR
  46.     do DEBUG.CMD
  47.     resume
  48.  
  49. procedure DEBUG.KEYBD.STOP        'Entered when F10 pressed
  50.     DB.CMDSTOP = 1
  51. endproc
  52.  
  53. procedure DEBUG.HELLO            'Describe available functions
  54.     cls
  55.     print "The Structured BASIC Program Debugger 1.12"
  56.     print string$(80,&HC4);
  57.     print
  58.     print "You can enter the debugger by:"
  59.     print 
  60.     print "   1. Pressing F10 during program execution,"
  61.     print "   2. Setting a procedure breakpoint with the B command,"
  62.     print "   3. Your program causing a BASIC error."
  63.     print
  64.     print "In the debugger, you can type:"
  65.     print
  66.     print "   X  to exit into BASIC (type CONT to go back),"
  67.     print "   D  to list the Structured BASIC procedures called,"
  68.     print "   B  to set a procedure breakpoint,"
  69.     print "   G  to resume your program's execution."
  70. endproc
  71.  
  72. procedure DEBUG.BASIC.ERROR        'Process BASIC errors
  73.     color 15,0
  74.     locate DB.STATUS.LINE,1,CUROFF
  75.     print using "##### ";ERL;
  76.     DB.ERROR = ERR
  77.     if DB.ERROR > 77
  78.         DB.ERROR = 77
  79.     endif
  80.     do DEBUG.ERROR.MSG
  81.     locate ,,CURON
  82.     color 7,0
  83. endproc
  84.  
  85. procedure DEBUG.ERROR.MSG        'Decode BASIC error msg
  86.     restore DB.ERROR.MSGS
  87.     repeat
  88.         read DB.ERR.KEY,DB.ERROR.MSG$
  89.         if DB.ERR.KEY = DB.ERROR
  90.             break
  91.         endif
  92.     until DB.ERR.KEY = 77
  93.     print using DB.MASK$;DB.ERROR.MSG$
  94. endproc
  95.  
  96. procedure DEBUG.PROC            'Handle procedure call
  97.     do DEBUG.PUSH.CURSOR
  98.     DB.LEVEL = DB.LEVEL + 1
  99.     DB.LABEL$(DB.LEVEL) = DEBUG.LABEL$
  100.     DB.LINE(DB.LEVEL) = DEBUG.LINE
  101.     do DEBUG.TRACE.MSG
  102.     if DB.BPOINT = 1 and DB.BPLABEL$ = DEBUG.LABEL$
  103.         DB.CMDSTOP = 1
  104.     endif
  105.     if DB.CMDSTOP = 1
  106.         do DEBUG.CLR.CMD
  107.         do DEBUG.CMD
  108.         DB.CMDSTOP = 0
  109.     endif
  110.     do DEBUG.POP.CURSOR
  111. endproc
  112.  
  113. procedure DEBUG.ENDP            'Handle procedure exit
  114.     do DEBUG.PUSH.CURSOR
  115.     DB.LEVEL = DB.LEVEL - 1
  116.     do DEBUG.TRACE.MSG
  117.     do DEBUG.POP.CURSOR
  118. endproc
  119.  
  120. procedure DEBUG.TRACE.MSG        'Display procedure and line
  121.     color 15,0
  122.     locate DB.STATUS.LINE,1,CUROFF
  123.     if DB.LEVEL > 0
  124.         print using "##### ";DB.LINE(DB.LEVEL);
  125.         print using DB.MASK$;DB.LABEL$(DB.LEVEL);
  126.     else
  127.         print using DB.MASK$;"Exit";
  128.     endif
  129.     locate ,,CURON
  130.     color 7,0
  131. endproc
  132.  
  133. procedure DEBUG.CMD                'Get and process commands
  134.     DB.DONE = 0
  135.     repeat
  136.         do DEBUG.GET.CMD
  137.         do DEBUG.DO.CMD
  138.     until DB.DONE = 1
  139.     do DEBUG.CLR.CMD
  140. endproc
  141.  
  142. procedure DEBUG.GET.CMD         'Get and proof debugger command
  143.     do DEBUG.CLR.CMD
  144.     print "debug: ";
  145.     repeat
  146.         do DEBUG.GET.KEY
  147.         DB.ISKEY = instr("BDGX",DB.KEY$)
  148.     until DB.ISKEY > 0
  149. endproc
  150.  
  151. procedure DEBUG.DO.CMD            'Call procedure for each command
  152.     if DB.KEY$ = "G"
  153.         DB.DONE = 1
  154.     elseif DB.KEY$ = "X"
  155.         do DEBUG.DO.STOP
  156.     elseif DB.KEY$ = "B"
  157.         do DEBUG.DO.BPOINT
  158.     elseif DB.KEY$ = "D"
  159.         do DEBUG.DO.DUMP
  160.     else
  161.         beep
  162.     endif
  163. endproc
  164.  
  165. procedure DEBUG.DO.STOP         'Handle exit to BASIC
  166.     print "exit to BASIC";
  167.     do DEBUG.POP.CURSOR
  168.     print : print "Type CONT to go back to debugger..."
  169.     stop
  170. endproc
  171.  
  172. procedure DEBUG.DO.BPOINT        'Set breakpoint
  173.     do DEBUG.CLR.CMD
  174.     print "breakpoint: ";
  175.     do DEBUG.GET.STRING
  176.     DB.BPLABEL$ = DB.INPUT$
  177.     if len(DB.BPLABEL$) > 0
  178.         DB.BPOINT = 1
  179.     else
  180.         DB.BPOINT = 0
  181.     endif
  182. endproc
  183.  
  184. procedure DEBUG.DO.DUMP         'Dump stack of procedure calls
  185.     print "dump procedure stack";
  186.     locate 1,38
  187.     print DB.TLBOX$;
  188.     for DB.I = 1 to 40 : print DB.TOP$; : next DB.I
  189.     print DB.TRBOX$
  190.     for DB.I = DB.LEVEL to 1 step -1
  191.         locate ,38
  192.         print DB.SIDE$;" ";
  193.         print using "##### ";DB.LINE(DB.I);
  194.         print using DB.MASK$;DB.LABEL$(DB.I);
  195.         print " ";DB.SIDE$
  196.     NEXT DB.I
  197.     locate ,38
  198.     print DB.BLBOX$;
  199.     for DB.I = 1 to 40 : print DB.TOP$; : next DB.I
  200.     print DB.BRBOX$;
  201. endproc
  202.  
  203. procedure DEBUG.GET.STRING        'Get label name for breakpoint
  204.     DB.INPUT$ = ""
  205.     DB.START.COL = pos(0)
  206.     repeat
  207.         do DEBUG.GET.KEY
  208.         if DB.KEY$ = DB.RET$ break
  209.         if DB.KEY$ = DB.BKSP$
  210.             do DEBUG.DEL.CHAR
  211.         elseif INSTR(DB.LABCHRS$,DB.KEY$) > 0
  212.             do DEBUG.INS.CHAR
  213.         else
  214.             beep
  215.         endif
  216.     until 1 = 0
  217. endproc
  218.  
  219. procedure DEBUG.GET.KEY         'Get uppercase key from keyboard
  220.     repeat
  221.         do DEBUG.CURSOR
  222.         DB.KEY$ = inkey$
  223.     until len(DB.KEY$) > 0
  224.     if asc(DB.KEY$) > 96 and asc(DB.KEY$) < 123
  225.         DB.KEY$ = chr$(asc(DB.KEY$) - 32)
  226.     endif
  227. endproc
  228.  
  229. procedure DEBUG.INS.CHAR        'Add char to end of breakpoint label
  230.     if pos(0) < 79
  231.         print DB.KEY$;
  232.         DB.INPUT$ = DB.INPUT$ + DB.KEY$
  233.     else
  234.         beep
  235.     endif
  236. endproc
  237.  
  238. procedure DEBUG.DEL.CHAR        'Handle backspace key in input
  239.     DB.CUR.COL = pos(0)
  240.     if DB.CUR.COL > DB.START.COL
  241.         DB.INPUT$ = left$(DB.INPUT$,len(DB.INPUT$)-1)
  242.         print " ";
  243.         locate ,DB.CUR.COL-1
  244.     else
  245.         beep
  246.     endif
  247. endproc
  248.  
  249. procedure DEBUG.CURSOR            'Simulate BASIC cursor
  250.     if DB.CURCNT = DB.BLINK
  251.         if DB.CURCHAR$ = DB.CURSOR$
  252.             DB.CURCHAR$ = " "
  253.         else
  254.             DB.CURCHAR$ = DB.CURSOR$
  255.         endif
  256.         DB.CURCNT = 0
  257.     endif
  258.     print DB.CURCHAR$;
  259.     DB.CURCNT = DB.CURCNT + 1
  260.     locate ,pos(0)-1
  261. endproc
  262.  
  263. procedure DEBUG.CLR.CMD         'Clear command area of status line
  264.     locate DB.STATUS.LINE,40,CUROFF
  265.     print space$(40);
  266.     locate DB.STATUS.LINE,40,CURON
  267. endproc
  268.  
  269. procedure DEBUG.CLR.MSG         'Clear message area of status line
  270.     locate DB.STATUS.LINE,1,CUROFF
  271.     print space$(40);
  272.     locate DB.STATUS.LINE,1,CURON
  273. endproc
  274.  
  275. procedure DEBUG.PUSH.CURSOR        'Save program's cursor
  276.     DB.ROW = csrlin : DB.COL = pos(0)
  277. endproc
  278.  
  279. procedure DEBUG.POP.CURSOR        'Restore program's cursor
  280.     locate DB.ROW,DB.COL
  281. endproc
  282.  
  283. DB.ERROR.MSGS|                    'Table of BASIC error messages
  284.     data  1,"NEXT without FOR"
  285.     data  2,"Syntax error"
  286.     data  3,"RETURN without GOSUB"
  287.     data  4,"Out of data"
  288.     data  5,"Illegal function call"
  289.     data  6,"Overflow"
  290.     data  7,"Out of memory"
  291.     data  8,"Undefined line number"
  292.     data  9,"Subscript out of range"
  293.     data 10,"Duplicate definition"
  294.     data 11,"Division by zero"
  295.     data 12,"Illegal direct"
  296.     data 13,"Type mismatch"
  297.     data 14,"Out of string space"
  298.     data 15,"String too long"
  299.     data 16,"String formula too complex"
  300.     data 17,"Can't continue"
  301.     data 18,"Undefined user function"
  302.     data 19,"No RESUME"
  303.     data 20,"RESUME without error"
  304.     data 22,"Missing operand"
  305.     data 23,"Line buffer overflow"
  306.     data 24,"Device timeout"
  307.     data 25,"Device fault"
  308.     data 26,"FOR without NEXT"
  309.     data 27,"Out of paper"
  310.     data 29,"WHILE without WEND"
  311.     data 30,"WEND without WHILE"
  312.     data 50,"FIELD overflow"
  313.     data 51,"Internal error"
  314.     data 52,"Bad file number"
  315.     data 53,"File not found"
  316.     data 54,"Bad file mode"
  317.     data 55,"File already open"
  318.     data 57,"Device I/O error"
  319.     data 58,"File already exists"
  320.     data 61,"Disk full"
  321.     data 62,"Input past end"
  322.     data 63,"Bad record number"
  323.     data 64,"Bad file name"
  324.     data 66,"Direct statement in file"
  325.     data 67,"Too many files"
  326.     data 68,"Device unavailable"
  327.     data 69,"Communication buffer overflow"
  328.     data 70,"Disk Write Protect"
  329.     data 71,"Disk not ready"
  330.     data 72,"Disk media error"
  331.     data 73,"Advanced feature"
  332.     data 74,"Rename across disks"
  333.     data 75,"Path/file access error"
  334.     data 76,"Path not found"
  335.     data 77,"Unprintable error"
  336.